SuperHack/SuperHack CD.bin/CODING/VBASIC/ATT.ZIP/LOCATION.FRM

Visual Basic Form | 1995-04-16 | 20.9 KB | 719 lines

VERSION 2.00
Begin Form LocationForm
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   3  'Fixed Double
   Caption         =   "Same Sun Rise & Set & Shine"
   ClientHeight    =   6510
   ClientLeft      =   2070
   ClientTop       =   480
   ClientWidth     =   5025
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   Height          =   6945
   Icon            =   LOCATION.FRX:0000
   Left            =   1995
   LinkTopic       =   "Form2"
   ScaleHeight     =   6510
   ScaleWidth      =   5025
   Top             =   120
   Width           =   5175
   Begin SSFrame Frame3D1
      ForeColor       =   &H00000000&
      Height          =   420
      Index           =   6
      Left            =   1440
      TabIndex        =   26
      Top             =   4920
      Width           =   975
      Begin TextBox tbNow
         Alignment       =   2  'Center
         BackColor       =   &H00C0C0C0&
         BorderStyle     =   0  'None
         Height          =   210
         Left            =   30
         MaxLength       =   9
         MultiLine       =   -1  'True
         TabIndex        =   27
         Tag             =   "h"
         Text            =   "09/17/95"
         Top             =   150
         Width           =   915
      End
   End
   Begin SSCheck DST
      Caption         =   "Daylight Savings Time"
      Height          =   255
      Left            =   720
      TabIndex        =   25
      Top             =   4650
      Width           =   3135
   End
   Begin ComboBox TZList
      Height          =   300
      Left            =   720
      Style           =   2  'Dropdown List
      TabIndex        =   24
      Top             =   3870
      Width           =   3615
   End
   Begin SSFrame Frame3D1
      ForeColor       =   &H00000000&
      Height          =   420
      Index           =   5
      Left            =   3840
      TabIndex        =   18
      Top             =   3090
      Width           =   495
      Begin TextBox LatDir
         Alignment       =   1  'Right Justify
         BackColor       =   &H00C0C0C0&
         BorderStyle     =   0  'None
         Height          =   210
         Left            =   36
         MaxLength       =   1
         MultiLine       =   -1  'True
         TabIndex        =   6
         Tag             =   "h"
         Text            =   "99"
         Top             =   150
         Width           =   405
      End
   End
   Begin SSFrame Frame3D1
      ForeColor       =   &H00000000&
      Height          =   420
      Index           =   4
      Left            =   2880
      TabIndex        =   17
      Top             =   3090
      Width           =   495
      Begin TextBox LatSec
         Alignment       =   1  'Right Justify
         BackColor       =   &H00C0C0C0&
         BorderStyle     =   0  'None
         Height          =   210
         Left            =   36
         MaxLength       =   2
         MultiLine       =   -1  'True
         TabIndex        =   5
         Tag             =   "h"
         Text            =   "99"
         Top             =   150
         Width           =   405
      End
   End
   Begin SSFrame Frame3D1
      ForeColor       =   &H00000000&
      Height          =   420
      Index           =   3
      Left            =   1920
      TabIndex        =   16
      Top             =   3090
      Width           =   495
      Begin TextBox LatDeg
         Alignment       =   1  'Right Justify
         BackColor       =   &H00C0C0C0&
         BorderStyle     =   0  'None
         Height          =   210
         Left            =   36
         MaxLength       =   2
         MultiLine       =   -1  'True
         TabIndex        =   4
         Tag             =   "h"
         Text            =   "99"
         Top             =   150
         Width           =   405
      End
   End
   Begin SSFrame Frame3D1
      ForeColor       =   &H00000000&
      Height          =   420
      Index           =   2
      Left            =   3840
      TabIndex        =   15
      Top             =   2670
      Width           =   495
      Begin TextBox LongDir
         Alignment       =   1  'Right Justify
         BackColor       =   &H00C0C0C0&
         BorderStyle     =   0  'None
         Height          =   210
         Left            =   36
         MaxLength       =   1
         MultiLine       =   -1  'True
         TabIndex        =   3
         Tag             =   "h"
         Text            =   "99"
         Top             =   150
         Width           =   405
      End
   End
   Begin SSFrame Frame3D1
      ForeColor       =   &H00000000&
      Height          =   420
      Index           =   1
      Left            =   2880
      TabIndex        =   14
      Top             =   2670
      Width           =   495
      Begin TextBox LongSec
         Alignment       =   1  'Right Justify
         BackColor       =   &H00C0C0C0&
         BorderStyle     =   0  'None
         Height          =   210
         Left            =   36
         MaxLength       =   2
         MultiLine       =   -1  'True
         TabIndex        =   2
         Tag             =   "h"
         Text            =   "99"
         Top             =   150
         Width           =   405
      End
   End
   Begin SSFrame Frame3D1
      ForeColor       =   &H00000000&
      Height          =   420
      Index           =   0
      Left            =   1920
      TabIndex        =   13
      Top             =   2670
      Width           =   495
      Begin TextBox LongDeg
         Alignment       =   1  'Right Justify
         BackColor       =   &H00C0C0C0&
         BorderStyle     =   0  'None
         Height          =   210
         Left            =   45
         MaxLength       =   3
         MultiLine       =   -1  'True
         TabIndex        =   1
         Tag             =   "h"
         Text            =   "99"
         Top             =   150
         Width           =   405
      End
   End
   Begin ComboBox CityList
      BackColor       =   &H00C0C0C0&
      ForeColor       =   &H00000000&
      Height          =   2445
      Left            =   720
      Style           =   1  'Simple Combo
      TabIndex        =   0
      Top             =   210
      Width           =   3615
   End
   Begin CommandButton Command1
      Caption         =   "OK"
      Default         =   -1  'True
      Height          =   330
      Left            =   1200
      TabIndex        =   8
      Top             =   5970
      Width           =   1170
   End
   Begin CommandButton Command3
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   330
      Left            =   2700
      TabIndex        =   9
      Top             =   5970
      Width           =   1170
   End
   Begin SSCheck DSTAuto
      Caption         =   "Daylight Savings Auto Adjustment"
      Height          =   255
      Left            =   720
      TabIndex        =   7
      Top             =   4290
      Width           =   3135
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Date"
      ForeColor       =   &H00000000&
      Height          =   255
      Index           =   7
      Left            =   720
      TabIndex        =   28
      Top             =   5070
      Width           =   495
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "'"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   255
      Index           =   6
      Left            =   3420
      TabIndex        =   23
      Top             =   3210
      Width           =   120
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "'"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   255
      Index           =   5
      Left            =   3420
      TabIndex        =   22
      Top             =   2820
      Width           =   120
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   255
      Index           =   4
      Left            =   2460
      TabIndex        =   21
      Top             =   3210
      Width           =   120
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   255
      Index           =   3
      Left            =   2460
      TabIndex        =   20
      Top             =   2820
      Width           =   120
   End
   Begin Label SunriseSunset
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      Caption         =   "Sunrise: 4:14am Sunset: 6:55p"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   255
      Left            =   720
      TabIndex        =   19
      Top             =   5490
      Width           =   3615
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Time Zone"
      ForeColor       =   &H00000000&
      Height          =   255
      Index           =   2
      Left            =   720
      TabIndex        =   12
      Top             =   3660
      Width           =   975
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Latitude"
      ForeColor       =   &H00000000&
      Height          =   255
      Index           =   1
      Left            =   720
      TabIndex        =   11
      Top             =   3240
      Width           =   975
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Longitude"
      ForeColor       =   &H00000000&
      Height          =   255
      Index           =   0
      Left            =   720
      TabIndex        =   10
      Top             =   2820
      Width           =   975
   End
Option Explicit
Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
Declare Function GetWindow Lib "User" (ByVal hWnd As Integer, ByVal wCmd As Integer) As Integer
Dim LocationLines%
Dim locationdetails$()
Dim LocationNames$()
Dim SettingCity%
Dim SettingText%
Dim tNow
Sub Calc ()
Dim LongMinus$, LatMinus$
Dim T$, Start%
Dim SunRise$
Dim Sunset$
T$ = TZList.Text
T$ = Trim$(Mid$(T$, InStr(T$, ")") + 1, 200))
Start = InStr(T$, ":")
If Start > 0 Then
  Mid(T$, Start, 1) = "."
End If
If LongDir.Text = "E" Then LongMinus$ = "-" Else LongMinus$ = ""
If LatDir.Text = "S" Then LatMinus$ = "-" Else LatMinus$ = ""
Call CalcSunRiseSet(LongMinus$ + LongDeg.Text + "." + LongSec.Text, LatMinus$ + LatDeg.Text + "." + LatSec.Text, Val(T$), (DST.Value), tNow, SunRise$, Sunset$)
SunRiseSunSet.Caption = "Sunrise: " + SunRise$ + "  Sunset: " + Sunset$
End Sub
Sub City_Change ()
'If SettingCity% Then Exit Sub
'Dim I%
'Dim SavedPos%
'If Left$(LocationNames$(CityList.ListIndex + 1), Len(City.Text)) = City.Text Then
   'I% = CityList.ListIndex + 1
'Else
   'MousePointer = 11
   'I% = 1
'End If
'While I% <= LocationLines%
   'If Left$(LocationNames$(I%), Len(City.Text)) = City.Text Then
      'SettingCity% = True
      'SavedPos% = City.SelStart
      'CityList.ListIndex = I% - 1
      'City.Text = CityList.List(CityList.ListIndex)
      'DoEvents
      'City.SelStart = SavedPos
      'City.SelLength = 30000
      'SettingCity% = False
      'MousePointer = 0
      'Exit Sub
   'End If
'I% = I% + 1
'Wend
'MousePointer = 0
End Sub
Sub City_GotFocus ()
'City.SelStart = 0
'City.SelLength = 3000
End Sub
Sub City_KeyPress (KeyAscii As Integer)
'If KeyAscii = 8 Then
   'City.SelStart = City.SelStart - 1
   'City.SelLength = 30000
   'DoEvents
   'City.SelText = ""
'End If
End Sub
Sub CityList_Click ()
   'City.Text = CityList.List(CityList.ListIndex)
Dim T$, I%
T$ = locationdetails(CityList.ListIndex + 1)
'123456789012345678901234567890
'N61 10 W149 59 HST Y  AK
SettingText = True
If Mid$(T$, 20, 1) = "Y" Then
   DSTAuto.Value = True
   DSTAuto.Value = False
End If
LatDir.Text = Mid$(T$, 1, 1)
Call LatDir_GotFocus
LatDeg.Text = Mid$(T$, 2, 2)
Call LatDeg_GotFocus
LatSec.Text = Mid$(T$, 5, 2)
Call LatSec_GotFocus
LongDir.Text = Mid$(T$, 8, 1)
Call LongDir_GotFocus
LongDeg.Text = Mid$(T$, 9, 3)
Call LongDeg_GotFocus
LongSec.Text = Mid$(T$, 13, 2)
Call LongSec_GotFocus
'TimeZone.Text = Mid$(T$, 16, 3)
TZList.ListIndex = -1
For I% = 1 To TZs%
  If InStr(TZ(I%), "(" + Mid$(T$, 16, 3) + ")") <> 0 Then TZList.ListIndex = I% - 1
Next I%
'Call TimeZone_GotFocus
SettingText = False
Call Calc
End Sub
Sub CityList_LostFocus ()
Const WM_USER = &H400
Const LB_GETTOPINDEX = (WM_USER + 15)
Const GW_CHILD = 5
Const GW_HWNDNEXT = 2
Dim T$
Dim TopIndex&
Dim TempWin%
'Declare Function GetWindow Lib "User" (ByVal hWnd As Integer, ByVal wCmd As Integer) As Integer
TempWin = GetWindow(CityList.hWnd, GW_CHILD)
TopIndex& = SendMessage(TempWin, LB_GETTOPINDEX, 0, 0&)
'TempWin = GetWindow(TempWin, GW_HWNDNEXT)
'TopIndex& = SendMessage(TempWin, LB_GETTOPINDEX, 0, 0&)
'!!!!!
'GetWIndow (GW_CHILD)
'GetWindow(HWNDNEXT)
T$ = CityList.List(TopIndex&)
If UCase$(Left$(T$, Len(CityList.Text))) = UCase$(CityList.Text) Then
   CityList.ListIndex = TopIndex
End If
End Sub
Sub Command1_Click ()
Dim T$
Call CityList_LostFocus
gLocation = CityList.Text
gLongitude = LongDeg.Text + "." + LongSec.Text + LongDir.Text
gLatitude = LatDeg.Text + "." + LatSec.Text + LatDir.Text
gDST = DST.Value
gDSTAuto = DSTAuto.Value
T$ = TZList.Text
gTimeZOne = Trim$(Mid$(T$, InStr(T$, "(") + 1, 3))
oldDate = -1
Unload Me
End Sub
Sub Command3_Click ()
Unload Me
End Sub
Sub DST_Click (Value As Integer)
If SettingText Then Exit Sub
Call Calc
End Sub
Sub DSTAuto_Click (Value As Integer)
If Value Then
   DST.Enabled = False
   Call SetDST
   DST.Enabled = True
End If
If SettingText Then Exit Sub
Call Calc
End Sub
Sub Form_Load ()
Dim GotIt%
Dim I%
Dim PPos%, T$
Dim K%
Screen.MousePointer = 11
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2
SettingText = True
tbNow.Text = Format$(Now, "Short Date")
CalcDSTStartStop (tbNow.Text)
If TZs% = 0 Then Call InitTimeZoneStuff
T$ = "(" + gTimeZOne + ")"
For I% = 1 To TZs%
  If TZ$(I%) <> "" Then TZList.AddItem TZ$(I%)
  If InStr(TZ$(I%), T$) Then K% = I% - 1
Next I%
TZList.ListIndex = K%
GotIt% = 0
Dim LocationLine$
Dim CITY$, State$
Dim CityState$
Dim Slash$
On Local Error Resume Next
Slash$ = App.Path
If Right$(Slash$, 1) <> "\" Then Slash$ = Slash$ + "\"
Open Slash$ + "CITIES.TXT" For Input As 1
If Err <> 0 Then
   Screen.MousePointer = 0
   MsgBox "CITIES.TXT could not be opened."
   Unload Me
   Exit Sub
End If
On Local Error GoTo 0
LocationLines% = 0
While Not EOF(1)
  Line Input #1, LocationLine$
  If Left$(LocationLine$, 1) <> "*" Then
     LocationLines% = LocationLines% + 1
     ReDim Preserve locationdetails$(LocationLines%)
     ReDim Preserve LocationNames$(LocationLines%)
     CITY$ = ""
     State$ = ""
     I% = InStr(1, LocationLine$, Chr$(9))
     If I% > 0 Then
    CITY$ = Left$(LocationLine$, I% - 1)
    LocationLine$ = Mid$(LocationLine$, I% + 1, 30000)
     End If

     I% = InStr(1, LocationLine$, Chr$(9))
     If I% > 0 Then
    State$ = Left$(LocationLine$, I% - 1)
    LocationLine$ = Mid$(LocationLine$, I% + 1, 30000)
     End If
     CITY$ = Trim$(CITY$)
     State$ = Trim$(State$)
     If State$ <> "" Then
    CityState$ = CITY$ + ", " + State$
     Else
    CityState$ = CITY$
     End If
     CityList.AddItem CityState$
     If CityState$ = gLocation Then GotIt% = CityList.ListCount
     LocationNames$(LocationLines%) = CityState$
     locationdetails$(LocationLines%) = LocationLine$
  End If
Close 1
Screen.MousePointer = 0
PPos% = InStr(gLongitude, ".")
LongDeg.Text = Left$(gLongitude, PPos% - 1)
T$ = Mid$(gLongitude, PPos% + 1, 255)
LongSec.Text = Left$(T$, Len(T$) - 1)
LongDir.Text = Right$(T$, 1)
PPos% = InStr(gLatitude, ".")
LatDeg.Text = Left$(gLatitude, PPos% - 1)
T$ = Mid$(gLatitude, PPos% + 1, 255)
LatSec.Text = Left$(T$, Len(T$) - 1)
LatDir.Text = Right$(T$, 1)
CityList.Text = gLocation
DST.Value = gDST
DSTAuto.Value = gDSTAuto
T$ = "(" + gTimeZOne + ")"
'time zone
'dst auto
SettingText = False
If GotIt% Then
   CityList.ListIndex = GotIt% - 1
   Call Calc
End If
'CityList.Text = "New York City, New York"
End Sub
Sub LatDeg_Change ()
If SettingText Then Exit Sub
Call Calc
End Sub
Sub LatDeg_GotFocus ()
LatDeg.SelStart = 0
LatDeg.SelLength = 30000
End Sub
Sub LatDeg_KeyPress (KeyAscii As Integer)
If KeyAscii >= 32 Then
   KeyAscii = Asc(UCase$(Chr$(KeyAscii)))
   If (KeyAscii < Asc("0")) Or (KeyAscii > Asc("9")) Then KeyAscii = 0
End If
End Sub
Sub LatDir_Change ()
If SettingText Then Exit Sub
Call Calc
End Sub
Sub LatDir_GotFocus ()
LatDir.SelStart = 0
LatDir.SelLength = 30000
End Sub
Sub LatDir_KeyPress (KeyAscii As Integer)
KeyAscii = Asc(UCase$(Chr$(KeyAscii)))
If (KeyAscii <> Asc("N")) And (KeyAscii <> Asc("S")) Then KeyAscii = 0
End Sub
Sub LatSec_Change ()
If SettingText Then Exit Sub
Call Calc
End Sub
Sub LatSec_GotFocus ()
LatSec.SelStart = 0
LatSec.SelLength = 30000
End Sub
Sub LatSec_KeyPress (KeyAscii As Integer)
If KeyAscii >= 32 Then
   KeyAscii = Asc(UCase$(Chr$(KeyAscii)))
   If (KeyAscii < Asc("0")) Or (KeyAscii > Asc("9")) Then KeyAscii = 0
End If
End Sub
Sub LongDeg_Change ()
If SettingText Then Exit Sub
Call Calc
End Sub
Sub LongDeg_GotFocus ()
LongDeg.SelStart = 0
LongDeg.SelLength = 30000
End Sub
Sub LongDeg_KeyPress (KeyAscii As Integer)
If KeyAscii >= 32 Then
   KeyAscii = Asc(UCase$(Chr$(KeyAscii)))
   If (KeyAscii < Asc("0")) Or (KeyAscii > Asc("9")) Then KeyAscii = 0
End If
End Sub
Sub LongDir_Change ()
If SettingText Then Exit Sub
Call Calc
End Sub
Sub LongDir_GotFocus ()
LongDir.SelStart = 0
LongDir.SelLength = 30000
End Sub
Sub LongDir_KeyPress (KeyAscii As Integer)
KeyAscii = Asc(UCase$(Chr$(KeyAscii)))
If (KeyAscii <> Asc("E")) And (KeyAscii <> Asc("W")) Then KeyAscii = 0
End Sub
Sub LongSec_Change ()
If SettingText Then Exit Sub
Call Calc
End Sub
Sub LongSec_GotFocus ()
LongSec.SelStart = 0
LongSec.SelLength = 30000
End Sub
Sub LongSec_KeyPress (KeyAscii As Integer)
If KeyAscii >= 32 Then
   KeyAscii = Asc(UCase$(Chr$(KeyAscii)))
   If (KeyAscii < Asc("0")) Or (KeyAscii > Asc("9")) Then KeyAscii = 0
End If
End Sub
Sub SetDST ()
Dim tSettingText
tSettingText = SettingText
SettingText = True
   If (tNow >= DSTStart) And (tNow < DSTStop) Then
      DST.Value = True
   Else
      DST.Value = False
   End If
SettingText = tSettingText
End Sub
Sub tbNow_Change ()
On Local Error Resume Next
tNow = DateValue(Format$(tbNow.Text, "Short Date"))
If DSTAuto.Value Then Call SetDST
If SettingText Then Exit Sub
If tbNow.Text = "" Then Exit Sub
Call Calc
End Sub
Sub tbNow_GotFocus ()
tbNow.SelStart = 0
tbNow.SelLength = 30000
End Sub
Sub tbNow_KeyPress (KeyAscii As Integer)
KeyAscii = Asc(UCase$(Chr$(KeyAscii)))
If KeyAscii >= 32 Then
   If (KeyAscii <> Asc("/")) And (KeyAscii <> Asc("-") And ((KeyAscii < Asc("0")) Or (KeyAscii > Asc("9")))) Then KeyAscii = 0
End If
End Sub
Sub tbNow_LostFocus ()
tbNow.Text = Format$(tbNow.Text, "Short Date")
End Sub
Sub TimeZone_GotFocus ()
'TimeZone.SelStart = 0
'TimeZone.SelLength = 30000
End Sub
Sub TZList_Click ()
If SettingText Then Exit Sub
Call Calc
End Sub